home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbtools1.arc / AEKEYBOX.BAS < prev    next >
BASIC Source File  |  1987-12-10  |  5KB  |  213 lines
  1. rem $linesize:132
  2. rem $title:'Application Engineer Standard Routines'
  3. rem $subtitle:'AEKEYBOX Select an index key from a scroll box'
  4. '                Include the COMMON values
  5. rem $include:'AESHARED.BAS'            
  6. '  12-Jan-87, modification .... need to check stack allocation(s)
  7.  
  8. sub Key.Select.Box(m.len%,qtxt2$(1),opt$,fl%,ky$,mr%,sc%) static
  9.  
  10. '  m.len%         Length of display line in view list
  11. '  qtxt2$(1)      Dialog text displayed in the initial key input block
  12. '  opt$           Item returned from KSB
  13. '  fl%            Index File Number
  14. '  ky$            Indexing Parameter
  15. '  mr%            Indexing Parameter
  16. '  sc%            Indexing Parameter
  17.  
  18.         if xh%(fl%,2%)=0% then  '  No keys in the index
  19.             opt$=""
  20.             mr%=0%
  21.             sc%=0%
  22.             exit sub
  23.         end if ' xh%(fl%,2%)=0%
  24.  
  25.         redim disp$(5%),mr.temp%(5%),sc.temp%(5%)
  26.         redim ttmm$(4%)
  27.  
  28.         ae.sstack%=ae.sstack%+1000%
  29.         if ae.sstack%>10000% then
  30.             call ae.error("KSB AESTACK Overflow")
  31.         end if
  32.  
  33.         high%=(ae.fg%(4%) and 7%)*16%+ae.hg%(4%)
  34.         norm%=(ae.bg%(4%) and 7%)*16%+ae.fg%(4%)
  35.  
  36.         uop$="ESC=Exit  RETURN=Select  F1=Search"
  37.  
  38.         d%=len(uop$)
  39.         for j%=1% to 4%
  40.             k%=len(dialog$(j%))
  41.             if k%>d% then d%=k%
  42.         next j%
  43.         w%=d%+m.len%+7%
  44.  
  45.         height%=12%
  46.         l.marg%=(80%-w%)/2%
  47.         t.marg%=(25%-height%)/2%
  48.         r.marg%=l.marg%+w%-1%
  49.         b.marg%=t.marg%+height%-4%
  50.         t.frame$=chr$(214%)+string$((w%-2%),196%)+chr$(183%)
  51.         b.frame$=chr$(211%)+string$((w%-2%),196%)+chr$(189%)
  52.         redim disp$(5%),mr.temp%(5%),sc.temp%(5%)
  53.         redim ttmm$(4%)
  54.         redim disp$(5%),mr.temp%(5%),sc.temp%(5%)
  55.         redim ttmm$(4%)
  56.         horz$=chr$(186%)+string$((w%-2%),32%)+chr$(186%)
  57.  
  58.         call getscreen(ae.screens%(ae.sstack%-999%),t.marg%,l.marg%,b.marg%,r.marg%,0%,0%)
  59.         call xqprint(t.frame$,t.marg%,l.marg%,norm%,0%)
  60.         call xqprint(b.frame$,b.marg%,l.marg%,norm%,0%)
  61.         for j%=t.marg%+1% to b.marg%-1%
  62.             call xqprint(horz$,j%,l.marg%,norm%,0%)
  63.         next j%
  64.         call xqprint(uop$,t.marg%+2%,l.marg%+5%+m.len%,norm%,0%)
  65.         for j%=1% to 4%
  66.             call xqprint(dialog$(j%),t.marg%+2%+j%,l.marg%+5%+m.len%,norm%,0%)
  67.         next j%
  68.         call I.Block.Frame(t.marg%+2%,l.marg%+2%,5%,m.len%,1%)
  69.         cycle%=0%
  70.         i.search%=1%
  71.  
  72.         while cycle%=0%
  73.             if i.search%=1% then
  74.                 y.loc%=1%
  75.                 ky$=""
  76.                 du$=""
  77.                 dn%=0%
  78.  
  79.                 for tcycle%=1% to 4%
  80.                     ttmm$(tcycle%)=dialog$(tcycle%)
  81.                     dialog$(tcycle%)=qtxt2$(tcycle%)
  82.                 next tcycle%
  83.  
  84.                 call Dialog.Two(ky$,m.len%,du$,dn%)
  85.  
  86.                 for tcycle%=1% to 4%
  87.                     dialog$(tcycle%)=ttmm$(tcycle%)
  88.                 next tcycle%
  89.  
  90.                 call Ctrl.Trim(ky$)
  91.                 call Bit.Find(fl%,ky$,mrec%,sc%)
  92.  
  93.                 if sc% then
  94.                     disp$(1%)=ky$
  95.                     mr.temp%(1%)=abs(mrec%)             ' Even if not exact.
  96.                     sc.temp%(1%)=sc%
  97.                 end if
  98.  
  99.                 for j%=2% to 5%
  100.                     disp$(j%)=string$(m.len%,32%)
  101.                     mr.temp%(j%)=0%
  102.                     sc.temp%(j%)=0%
  103.                     p.mrec%=mrec%
  104.                     call Bit.Next(fl%,ky$,mrec%,sc%)
  105.                     if sc% then
  106.                         if p.mrec%<>mrec% then
  107.                             disp$(j%)=ky$
  108.                             mr.temp%(j%)=mrec%
  109.                             sc.temp%(j%)=sc%
  110.                         end if
  111.                     end if
  112.                 next j%
  113.                 i.search%=0%
  114.             end if
  115.  
  116.  
  117.             for j%=1% to 5%
  118.                     if j%=y.loc% then
  119.                         call xqprint(left$(disp$(j%),m.len%),j%+t.marg%+1%,l.marg%+2%,high%,0%)
  120.                     end if
  121.                     if j%<>y.loc% then
  122.                         call xqprint(left$(disp$(j%),m.len%),j%+t.marg%+1%,l.marg%+2%,norm%,0%)
  123.                     end if
  124.             next j%
  125.  
  126.             call Get.Single(ccode%,typ%)
  127.  
  128.             if typ%=2% then
  129.  
  130.                 if ccode%=59% then         ' F1, another search
  131.                     i.search%=1%
  132.                 end if
  133.  
  134.                 if ccode%=72% then         'Up Arrow
  135.                     y.loc%=y.loc%-1%
  136.                     if y.loc%=0% then
  137.                         ky$=disp$(1%)
  138.                         mrec%=mr.temp%(1%)
  139.                         sc%=sc.temp%(1%)
  140.                         p.mrec%=mrec%
  141.                         call Bit.Prev(fl%,ky$,mrec%,sc%)
  142.                         if sc% then
  143.                             if p.mrec%<>mrec% then
  144.                                 for j%=5% to 2% step -1%
  145.                                     disp$(j%)=disp$(j%-1%)
  146.                                     mr.temp%(j%)=mr.temp%(j%-1%)
  147.                                     sc.temp%(j%)=sc.temp%(j%-1%)
  148.                                 next j%
  149.                             end if
  150.                             disp$(1%)=ky$
  151.                             mr.temp%(1%)=mrec%
  152.                             sc.temp%(1%)=sc%
  153.                         end if
  154.                         y.loc%=1%
  155.                     end if
  156.                 end if
  157.  
  158.                 if ccode%=80% then         'Dn Arrow
  159.                     if y.loc%<5% then
  160.                         if sc.temp%(y.loc%+1%)=0% then
  161.                             y.loc%=y.loc%-1%
  162.                         end if
  163.                     end if
  164.                     y.loc%=y.loc%+1%
  165.                     if y.loc%=6% then
  166.                         ky$=disp$(5%)
  167.                         mrec%=mr.temp%(5%)
  168.                         sc%=sc.temp%(5%)
  169.                         p.mrec%=mrec%
  170.                         call Bit.Next(fl%,ky$,mrec%,sc%)
  171.                         if sc% then
  172.                             if mrec%<>p.mrec% then
  173.                                 for j%=1% to 4%
  174.                                     disp$(j%)=disp$(j%+1%)
  175.                                     mr.temp%(j%)=mr.temp%(j%+1%)
  176.                                     sc.temp%(j%)=sc.temp%(j%+1%)
  177.                                 next j%
  178.                                 disp$(5%)=ky$
  179.                                 mr.temp%(5%)=mrec%
  180.                                 sc.temp%(5%)=sc%
  181.                             end if
  182.                         end if
  183.                         y.loc%=5%
  184.                     end if
  185.                 end if
  186.             end if
  187.  
  188.             if typ%=1% then
  189.                 if ccode%=13% then         ' RETURN key
  190.                     cycle%=1%
  191.                     mr%=mr.temp%(y.loc%)
  192.                     ky$=disp$(y.loc%)
  193.                     sc%=sc.temp%(y.loc%)
  194.                 end if
  195.                 if ccode%=27% then         ' ESCAPE key
  196.                     cycle%=1%
  197.                     mr%=0%
  198.                     ky$=""
  199.                     sc%=0%
  200.                 end if
  201.             end if
  202.  
  203.         wend
  204.  
  205.         opt$=disp$(y.loc%)
  206.         call putscreen(ae.screens%(ae.sstack%-999%),t.marg%,l.marg%,b.marg%,r.marg%,0%,0%)
  207.         ae.sstack%=ae.sstack%-1000%
  208.  
  209.         erase disp$,mr.temp%,sc.temp%,ttmm$
  210.  
  211.  
  212.     end sub
  213.